home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / var / lib / defoma / scripts / pango.defoma < prev    next >
Text File  |  2009-10-28  |  9KB  |  345 lines
  1. @ACCEPT_CATEGORIES = qw(xfont);
  2.  
  3. # vim:syntax=perl
  4.  
  5. package pango;
  6.  
  7. use strict;
  8. use POSIX;
  9. use Debian::Defoma::Common;
  10. use Debian::Defoma::Font;
  11. use Debian::Defoma::Id;
  12. use vars qw($ROOTDIR %UNSUPPORTED_XLFD);
  13.  
  14. import Debian::Defoma::Common;
  15. import Debian::Defoma::Font;
  16. import Debian::Defoma::Id;
  17.  
  18. my @Families = qw(sans serif monospace);
  19. my @Encodings = qw(iso8859_X iso10646 other);
  20.  
  21. my %Ids;
  22. my $PkgDir = $ROOTDIR . '/pango.d';
  23. my $PangoAlias = $PkgDir . '/pangox.aliases';
  24. my $PangoAliases = '/etc/pango/pangox.aliases';
  25. my $ConfFile = '/etc/defoma/config/pango.conf';
  26. my $term = 0;
  27. my $init = 0;
  28.  
  29. ## This function generates each element of XLFD from hashed hints, and
  30. ## returns in a hashed XLFD.
  31.  
  32. sub get_xlfd_element {
  33.     my @xlfd = split (/-/, shift);
  34.     my $ret = {};
  35.  
  36.     $ret->{Foundry} = $xlfd[1];
  37.     $ret->{Family} = $xlfd[2];
  38.     $ret->{Weight} = $xlfd[3];
  39.     $ret->{Slant} = $xlfd[4];
  40.     $ret->{SetWidth} = $xlfd[5];
  41.     $ret->{Style} = $xlfd[6];
  42.     $ret->{Pixel} = $xlfd[7];
  43.     $ret->{Point} = $xlfd[8];
  44.     $ret->{ResX} = $xlfd[9];
  45.     $ret->{ResY} = $xlfd[10];
  46.     $ret->{Spacing} = $xlfd[11];
  47.     $ret->{AvgWidth} = $xlfd[12];
  48.     $ret->{Encoding} = "$xlfd[13]-$xlfd[14]";
  49.  
  50.     return $ret;
  51. }
  52.  
  53. ## Returns a string XLFD from hashed XLFD.
  54. sub generate_xlfd {
  55.     my $xe = shift;
  56.     my $enc = $xe->{Encoding};
  57.  
  58.     $enc = '*-*' if ($xe->{Encoding} =~ /iso8859-[0-9]+/);
  59.     return join ('-', '', $xe->{Foundry}, $xe->{Family}, $xe->{Weight},
  60.              $xe->{Slant}, $xe->{SetWidth}, $xe->{Style}, '*', '*',
  61.              '*', '*', '*', '*', $enc);
  62. }
  63.  
  64. # store XLFD
  65. sub store_xlfd {
  66.     my $Id = shift;
  67.     my @cache = defoma_id_grep_cache ($Id, 'installed', sorttype => 'p');
  68.     my @nnnn_xlfd = ();
  69.     my @innn_xlfd = ();
  70.     my @nnbn_xlfd = ();
  71.     my @inbn_xlfd = ();
  72.     my $xe;
  73.     my $xlfd;
  74.  
  75.     foreach my $i (@cache) {
  76.         my $font = $Id->{1}->[$i];
  77.         $font =~ s/_/ /g;
  78.         $xe = get_xlfd_element ($font);
  79.         my $enc = "$xe->{Foundry}-$xe->{Family}-$xe->{Encoding}";
  80.         $xlfd = generate_xlfd ($xe);
  81.  
  82.         if ($xe->{Weight} =~ /bold/ && ($xe->{Slant} eq 'o' || $xe->{Slant} eq 'i')) {
  83.             push (@inbn_xlfd, $xlfd) if (!grep (/\Q$enc/, @inbn_xlfd));
  84.             next;
  85.         }
  86.         if ($xe->{Weight} !~ /bold/ && ($xe->{Slant} eq 'o' || $xe->{Slant} eq 'i')) {
  87.             push (@innn_xlfd, $xlfd) if (!grep (/\Q$enc/, @innn_xlfd));
  88.             next;
  89.         }
  90.         if ($xe->{Weight} =~ /bold/ && $xe->{Slant} =~ /r/) {
  91.             push (@nnbn_xlfd, $xlfd) if (!grep (/\Q$enc/, @nnbn_xlfd));
  92.             next;
  93.         }
  94.         push (@nnnn_xlfd, $xlfd) if (!grep (/\Q$enc/, @nnnn_xlfd));
  95.     }
  96.     return \(@nnnn_xlfd, @innn_xlfd, @nnbn_xlfd, @inbn_xlfd);
  97. }
  98.  
  99. # write section
  100. sub write_section {
  101.     my $file = shift;
  102.     my $family = shift;
  103.  
  104.     my @nnnn_iso8859_X = ();
  105.     my @innn_iso8859_X = ();
  106.     my @nnbn_iso8859_X = ();
  107.     my @inbn_iso8859_X = ();
  108.     my @nnnn_iso10646 = ();
  109.     my @innn_iso10646 = ();
  110.     my @nnbn_iso10646 = ();
  111.     my @inbn_iso10646 = ();
  112.     my @nnnn_other = ();
  113.     my @innn_other = ();
  114.     my @nnbn_other = ();
  115.     my @inbn_other = ();
  116.     my $id_iso8859_X = $family . '_iso8859_X';
  117.     my $id_iso10646 = $family . '_iso10646';
  118.     my $id_other = $family . '_other';
  119.     my $hash;
  120.     my ($nnnn, $innn, $nnbn, $inbn);
  121.  
  122.     open (F, ">> $file");
  123.     ($nnnn, $innn, $nnbn, $inbn) = store_xlfd ($Ids{$id_other});
  124.     @nnnn_other = @{$nnnn};
  125.     @innn_other = @{$innn};
  126.     @nnbn_other = @{$nnbn};
  127.     @inbn_other = @{$inbn};
  128.     ($nnnn, $innn, $nnbn, $inbn) = store_xlfd ($Ids{$id_iso10646});
  129.     @nnnn_iso10646 = @{$nnnn};
  130.     @innn_iso10646 = @{$innn};
  131.     @nnbn_iso10646 = @{$nnbn};
  132.     @inbn_iso10646 = @{$inbn};
  133.     ($nnnn, $innn, $nnbn, $inbn) = store_xlfd ($Ids{$id_iso8859_X});
  134.     @nnnn_iso8859_X = @{$nnnn};
  135.     @innn_iso8859_X = @{$innn};
  136.     @nnbn_iso8859_X = @{$nnbn};
  137.     @inbn_iso8859_X = @{$inbn};
  138.  
  139.     print F "$family normal normal normal normal \\\n\t\"";
  140.     if (scalar (@nnnn_other) > 0) {
  141.         print F join (",\\\n\t", @nnnn_other);
  142.         print F ",\\\n\t";
  143.     }
  144.     if (scalar (@nnnn_iso10646) > 0) {
  145.         print F join (",\\\n\t", @nnnn_iso10646);
  146.         print F ",\\\n\t";
  147.     }
  148.     if (exists ($UNSUPPORTED_XLFD {"$family-normal-normal-normal-normal"})) {
  149.         print F $UNSUPPORTED_XLFD {"$family-normal-normal-normal-normal"};
  150.         print F ",\\\n\t";
  151.     }
  152.     if (scalar (@nnnn_iso8859_X) > 0) {
  153.         print F join (",\\\n\t", @nnnn_iso8859_X);
  154.         print F ",\\\n\t";
  155.     }
  156.     print F "-*-fixed-medium-r-normal--*-*-*-*-*-*-*-*\"\n\n";
  157.  
  158.     print F "$family italic normal normal normal \\\n\t\"";
  159.     if (scalar (@innn_other) > 0) {
  160.         print F join (",\\\n\t", @innn_other);
  161.         print F ",\\\n\t";
  162.     }
  163.     if (scalar (@innn_iso10646) > 0) {
  164.         print F join (",\\\n\t", @innn_iso10646);
  165.         print F ",\\\n\t";
  166.     }
  167.     if (exists ($UNSUPPORTED_XLFD {"$family-italic-normal-normal-normal"})) {
  168.         print F $UNSUPPORTED_XLFD {"$family-italic-normal-normal-normal"};
  169.         print F ",\\\n\t";
  170.     }
  171.     if (scalar (@innn_iso8859_X) > 0) {
  172.         print F join (",\\\n\t", @innn_iso8859_X);
  173.         print F ",\\\n\t";
  174.     }
  175.     print F "-*-fixed-medium-i-normal--*-*-*-*-*-*-*-*\"\n\n";
  176.  
  177.     print F "$family normal normal bold normal \\\n\t\"";
  178.     if (scalar (@nnbn_other) > 0) {
  179.         print F join (",\\\n\t", @nnbn_other);
  180.         print F ",\\\n\t";
  181.     }
  182.     if (scalar (@nnbn_iso10646) > 0) {
  183.         print F join (",\\\n\t", @nnbn_iso10646);
  184.         print F ",\\\n\t";
  185.     }
  186.     if (exists ($UNSUPPORTED_XLFD {"$family-normal-normal-bold-normal"})) {
  187.         print F $UNSUPPORTED_XLFD {"$family-normal-normal-bold-normal"};
  188.         print F ",\\\n\t";
  189.     }
  190.     if (scalar (@nnbn_iso8859_X) > 0) {
  191.         print F join (",\\\n\t", @nnbn_iso8859_X);
  192.         print F ",\\\n\t";
  193.     }
  194.     print F "-*-fixed-bold-r-normal--*-*-*-*-*-*-*-*\"\n\n";
  195.  
  196.     print F "$family italic normal bold normal \\\n\t\"";
  197.     if (scalar (@inbn_other) > 0) {
  198.         print F join (",\\\n\t", @inbn_other);
  199.         print F ",\\\n\t";
  200.     }
  201.     if (scalar (@inbn_iso10646) > 0) {
  202.         print F join (",\\\n\t", @inbn_iso10646);
  203.         print F ",\\\n\t";
  204.     }
  205.     if (exists ($UNSUPPORTED_XLFD {"$family-italic-normal-bold-normal"})) {
  206.         print F $UNSUPPORTED_XLFD {"$family-italic-normal-bold-normal"};
  207.         print F ",\\\n\t";
  208.     }
  209.     if (scalar (@inbn_iso8859_X) > 0) {
  210.         print F join (",\\\n\t", @inbn_iso8859_X);
  211.         print F ",\\\n\t";
  212.     }
  213.     print F "-*-fixed-bold-i-normal--*-*-*-*-*-*-*-*\"\n\n";
  214.     close F;
  215. }
  216.  
  217. sub do_init {
  218.     return if ($init);
  219.  
  220.     $init = 1;
  221.     foreach my $i (@Families) {
  222.         foreach my $j (@Encodings) {
  223.             my $id = $i . '_' . $j;
  224.             $Ids{$id} = defoma_id_open_cache ($id);
  225.         }
  226.     }
  227.     if ( -f $ConfFile ) {
  228.         do "$ConfFile" or die ("$@\n");
  229.     }
  230.     return 0;
  231. }
  232.  
  233. sub do_term {
  234.     unless ($term) {
  235.         $term = 1;
  236.  
  237.         my $xe;
  238.         my $xlfd;
  239.  
  240.         open (F, "> $PangoAlias.bak") or die "$PangoAlias.bak: $!";
  241.         print F "## THIS FILE IS GENERATED BY DEFOMA, DO NOT EDIT\n\n";
  242.         close F;
  243.  
  244.         ## Sans
  245.         write_section ("$PangoAlias.bak", "sans");
  246.  
  247.         ## Serif
  248.         write_section ("$PangoAlias.bak", "serif");
  249.  
  250.         ## Monospace
  251.         write_section ("$PangoAlias.bak", "monospace");
  252.  
  253.         rename ("$PangoAlias.bak", "$PangoAlias");
  254.         foreach my $i (@Families) {
  255.             foreach my $j (@Encodings) {
  256.                 my $id = $i . '_' . $j;
  257.                 defoma_id_close_cache ($Ids{$id});
  258.                 $Ids{$id} = undef;
  259.             }
  260.         }
  261.     }
  262.     return 0;
  263. }
  264.  
  265. sub actual_register {
  266.     my ($font, $h, $cache) = @_;
  267.     my $id_iso8859_X;
  268.     my $id_iso10646;
  269.     my $id_other;
  270.     my $xe;
  271.  
  272.     $id_iso8859_X = $cache . "_iso8859_X";
  273.     $id_iso10646 = $cache . "_iso10646";
  274.     $id_other = $cache . "_other";
  275.     $xe = get_xlfd_element ($font);
  276.     if ($xe->{Encoding} =~ /iso8859-[0-9]+/) {
  277.         defoma_id_register ($Ids{$id_iso8859_X},
  278.                     type => 'real',
  279.                     font => $font,
  280.                     id => $font,
  281.                     priority => $h->{Priority});
  282.     } elsif ($xe->{Encoding} =~ /iso10646/) {
  283.         defoma_id_register ($Ids{$id_iso10646},
  284.                     type => 'real',
  285.                     font => $font,
  286.                     id => $font,
  287.                     priority => $h->{Priority});
  288.     } else {
  289.         defoma_id_register ($Ids{$id_other},
  290.                     type => 'real',
  291.                     font => $font,
  292.                     id => $font,
  293.                     priority => $h->{Priority});
  294.     }
  295. }
  296.  
  297. sub do_register {
  298.     my $font = shift;
  299.     my @hints = defoma_font_get_hints ('xfont', $font);
  300.     my $h = parse_hints_start ('', @hints);
  301.     my $cache = "monospace";
  302.     my $registered = 0;
  303.  
  304.     if (exists ($h->{'Shape'}) && $h->{'Shape'} =~ /\bNoSerif\b/) {
  305.         $cache = "sans";
  306.         actual_register ($font, $h, $cache);
  307.         $registered = 1;
  308.     }
  309.     if (exists ($h->{'Shape'}) && $h->{'Shape'} =~ /\bSerif\b/) {
  310.         $cache = "serif";
  311.         actual_register ($font, $h, $cache);
  312.         $registered = 1;
  313.     }
  314.     if ((exists ($h->{'Width'}) && $h->{'Width'} =~ /\bFixed\b/) || !$registered) {
  315.         $cache = "monospace";
  316.         actual_register ($font, $h, $cache);
  317.     }
  318.     
  319.     return 0;
  320. }
  321.  
  322. sub do_unregister {
  323.     my $font = shift;
  324.  
  325.     foreach my $i (@Families) {
  326.         foreach my $j (@Encodings) {
  327.             my $id = $i . '_' . $j;
  328.             defoma_id_unregister ($Ids{$id}, type => 'real', font => $font);
  329.         }
  330.     }
  331. }
  332.  
  333. sub xfont {
  334.     my $arg = shift;
  335.  
  336.     if ($arg eq 'init') { return do_init (); }
  337.     elsif ($arg eq 'term') { return do_term (); }
  338.     elsif ($arg eq 'register') { return do_register (@_); }
  339.     elsif ($arg eq 'unregister') { return do_unregister (@_); }
  340.     return 0;
  341. }
  342.  
  343. 1;
  344.  
  345.